home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Floppyshop 2
/
Floppyshop - 2.zip
/
Floppyshop - 2.iso
/
art&graf.ix
/
art-0039
/
source
/
dccnvimg.mod
< prev
next >
Wrap
Text File
|
1997-04-16
|
9KB
|
273 lines
IMPLEMENTATION MODULE DCCnvImg;
(*---------------------------------------------------------------------*)
(* Convert Rectangular portion of the picture. *)
(* *)
(* The information for the conversion came from Personal Computer *)
(* World Magazine - July 1988. And examining the output of the *)
(* snapshot utility provided with 1st Word Plus ( Version 3, nice! ).*)
(* *)
(* Any faults with the implementation are, as usual, all mine. *)
(* *)
(* In my usual fashion, the coding will be very simple in this *)
(* version. Specifically, when a scan line is all off or on, it will *)
(* be coded using 'SOLID_RUN' otherwise it is coded as a *)
(* 'BIT_STRING'. The idea is to arrange for DTP packages to read *)
(* the image, not encode it in a compressed form. *)
(* Well... maybe some compression. *)
(* *)
(* Version 1.00 November 1988 L.G.Miller *)
(*---------------------------------------------------------------------*)
(* IMPORT Trace; *)
FROM SYSTEM IMPORT WORD, ADDRESS, ADR, BYTE;
FROM DCGlobal IMPORT PictureImage,
HiRes, MedRes,
MedResMaxX, MedResMaxY,
HiResMaxX, HiResMaxY,
HiResScreen,
BITSPERWORD;
FROM DCQuickFunctions IMPORT TestBit, SetBit, LUDivRem;
FROM Graphics IMPORT graf_mouse;
FROM ManyWindows IMPORT HideMouse,
ShowMouse;
CONST
CMaxScanLen = 80; (* bytes *)
Arrow = 0;
HourGlass = 2;
TYPE
CharPtr = POINTER TO CHAR;
IMGHeader =
RECORD
VersionNo, (* constant 1 *)
HeaderLength, (* 8 words *)
NoPlanes, (* 1 - mono *)
PatternLength, (* 2 words *)
SPixelWidth, (* Source Pixel Width *)
SPixelHeight, (* Dest Pixel Width *)
ScanPixelWidth, (* Scan width in pixels *)
ScanLineDepth (* No. Of Lines Deep *)
: INTEGER; (* 16 bits *)
END;
(*----------------------------------------------------------------------*)
(* *)
(*----------------------------------------------------------------------*)
PROCEDURE QueryPicturePixel( x, y : INTEGER ; (* co-ords *)
VAR pic : HiResScreen ) : BOOLEAN;
BEGIN
RETURN TestBit( x, pic[y] );
END QueryPicturePixel;
PROCEDURE QueryAllOnOff( VAR X, Y, W : INTEGER;
VAR SLine : ARRAY OF CHAR;
VAR Pic : HiResScreen ) : INTEGER;
VAR i, CountOn, CountOff, bitno : INTEGER;
BEGIN
FOR i := 0 TO CMaxScanLen-1 DO SLine[i] := CHAR(0) END;
CountOn := 0;
CountOff := 0;
bitno := 0;
FOR i := X TO X + W - 1 DO
IF QueryPicturePixel(i, Y, Pic ) THEN
SetBit(bitno, SLine);
INC(CountOn);
ELSE
INC(CountOff)
END; (* if *)
INC(bitno);
END; (* for i *)
IF ( CountOn # 0 ) AND ( CountOff # 0 ) THEN
RETURN( 0 );
ELSIF CountOn # 0 THEN
RETURN ( 1 )
ELSE
RETURN ( -1 )
END;
END QueryAllOnOff;
PROCEDURE OnOrOffLength( SIndex, SLen : INTEGER;
VAR SLine : ARRAY OF CHAR ) : INTEGER;
VAR len : INTEGER;
LikeByte : CHAR;
BEGIN
len := 0;
LikeByte := CHAR(SLine[SIndex]);
IF ( LikeByte # CHAR(0) )
AND ( LikeByte # CHAR(255) ) THEN
RETURN len
END; (* if *)
WHILE ( SIndex < SLen )
AND ( SLine[SIndex] = LikeByte ) DO
INC(len);
INC(SIndex);
END; (* while *)
RETURN len
END OnOrOffLength;
PROCEDURE NotOnOrOffLength( SIndex, SLen : INTEGER;
VAR SLine : ARRAY OF CHAR ) : INTEGER;
VAR len : INTEGER;
BEGIN
len := 0;
WHILE ( SIndex < SLen )
AND ( SLine[SIndex] > CHAR(0) )
AND ( SLine[SIndex] < CHAR(255) ) DO
INC(len);
INC(SIndex);
END; (* while *)
RETURN len
END NotOnOrOffLength;
PROCEDURE CompressScanLine( SLen : INTEGER;
VAR SLine : ARRAY OF CHAR;
VAR OFileLen : CARDINAL;
VAR OFilePtr : CharPtr );
VAR i, j, len : INTEGER;
BEGIN
i := 0;
WHILE i < SLen DO
len := OnOrOffLength( i, SLen, SLine );
IF ( ( len > 0 )
OR ( (i+len) >= SLen ) ) THEN
IF ( SLine[i] = CHAR(0) ) THEN
OFilePtr^ := CHR(len);
ELSE
OFilePtr^ := CHR(len+128);
END; (* if *)
OFilePtr := ADDRESS(LONGCARD(OFilePtr) + LONGCARD(1));
INC(OFileLen);
INC(i,len);
ELSE
len := NotOnOrOffLength( i, SLen, SLine );
OFilePtr^ := CHR(80H);
OFilePtr := ADDRESS(LONGCARD(OFilePtr) + LONGCARD(1));
INC(OFileLen);
OFilePtr^ := CHR(len);
OFilePtr := ADDRESS(LONGCARD(OFilePtr) + LONGCARD(1));
INC(OFileLen);
FOR j := 1 TO len DO
OFilePtr^ := SLine[i];
OFilePtr := ADDRESS(LONGCARD(OFilePtr) + LONGCARD(1));
INC(OFileLen);
INC(i);
END; (* for j *)
END; (* if *)
END; (* while i *)
END CompressScanLine;
PROCEDURE ConvertToImage ( VAR PicImageDetails : PictureImage;
VAR Picture : HiResScreen;
VAR OutLen : CARDINAL;
VAR OutFile : ADDRESS );
VAR i, j, AllOnOff : INTEGER;
SWBytes : INTEGER; (* Scan Width In Bytes *)
IMGPtr, IMGDetPtr : CharPtr; (* cheat time *)
ScanLine : ARRAY [ 0 .. 80 ] OF CHAR;
IMGHeadDet : IMGHeader;
BEGIN
HideMouse;
i := graf_mouse(HourGlass, NIL);
ShowMouse;
OutLen := 0;
IMGPtr := OutFile;
IMGDetPtr := ADR(IMGHeadDet);
WITH IMGHeadDet DO
VersionNo := 1; (* constant 1 *)
HeaderLength := 8; (* 8 words *)
NoPlanes := 1; (* 1 - mono *)
PatternLength := 2; (* 2 words *)
SPixelWidth := 170; (* Source Pixel Width *)
SPixelHeight := 170; (* Dest Pixel Width *)
ScanPixelWidth := PicImageDetails.Width;
(* Scan width in pixels *)
ScanLineDepth := PicImageDetails.Height;
(* No. Of Lines Deep *)
END; (* with *)
FOR i := 1 TO 16 DO
IMGPtr^ := IMGDetPtr^;
IMGPtr := ADDRESS(LONGCARD(IMGPtr)+LONGCARD(1));
IMGDetPtr := ADDRESS(LONGCARD(IMGDetPtr)+LONGCARD(1));
END;
OutLen := 16;
WITH PicImageDetails DO
IF (Width MOD 8) = 0 THEN
SWBytes:= (Width DIV 8); (* exact no. bytes *)
ELSE
SWBytes:= (Width DIV 8) + 1;
END; (* if *)
FOR i := 0 TO Height-1 DO
j := StartY + i;
AllOnOff := QueryAllOnOff( StartX, j, Width,
ScanLine,
Picture );
IF AllOnOff # 0 THEN (* 0 is mixture of on/off *)
IF AllOnOff > 0 THEN (* all on *)
IMGPtr^ := CHR(SWBytes+128);
IMGPtr := ADDRESS(LONGCARD(IMGPtr)+LONGCARD(1));
INC(OutLen);
ELSE
IMGPtr^ := CHR(SWBytes);
IMGPtr := ADDRESS(LONGCARD(IMGPtr)+LONGCARD(1));
INC(OutLen);
END; (* if *)
ELSE
CompressScanLine( SWBytes, ScanLine, OutLen, IMGPtr );
END; (* if *)
END; (* for i *)
END; (* with *)
HideMouse;
i := graf_mouse(Arrow, NIL);
ShowMouse;
END ConvertToImage;
END DCCnvImg.